(library (grid-gen Roe)

(export Roe:dF Roe:dFl Roe:vm)

(import (guile);(chezscheme);(rnrs)
        (grid-gen main)
        (grid-gen vars)
        (grid-gen phys)
        (grid-gen math)
        (grid-gen symath)
        (except (srfi srfi-1) map)
)

(define Roe:vm (lambda (vl vr)
  (letrec*
    ((self (lambda (v)
    (cond ((eq? v 'c) `(sqrt ,(self 'c2)))
          ((eq? v 'c2)
          `(+ (/ (+ (* (sqrt ,(vl 'rho)) (** ,(vl 'c) 2.0))
                    (* (sqrt ,(vr 'rho)) (** ,(vr 'c) 2.0))
                 )
                 (+ (sqrt ,(vl 'rho)) (sqrt ,(vr 'rho)))
              )
              (* (* (- ,PHYS:gam 1.0) 0.5)
                 (* (/ (sqrt (* ,(vl 'rho) ,(vr 'rho)))
                       (** (+ (sqrt ,(vl 'rho)) 
                              (sqrt ,(vr 'rho))
                           )
                           2.0
                       )
                    )
                    (+ (** (- ,(vr 'u) ,(vl 'u)) 2.0)
                       (** (- ,(vr 'v) ,(vl 'v)) 2.0)
                       (** (- ,(vr 'w) ,(vl 'w)) 2.0)
                    )
                 )
              )
           )
          )
          ((eq? v 'vl) vl)
          ((eq? v 'vr) vr)
          (#t ((PHYS:vrs:rhuvw  `(sqrt (* ,(vl 'rho) ,(vr 'rho)))
                                `(/ (+ (* (sqrt ,(vl 'rho)) ,(vl 'h)) 
                                       (* (sqrt ,(vr 'rho)) ,(vr 'h))
                                    )
                                    (+ (sqrt ,(vl 'rho)) (sqrt ,(vr 'rho)))
                                 )
                                `(/ (+ (* (sqrt ,(vl 'rho)) ,(vl 'u))
                                       (* (sqrt ,(vr 'rho)) ,(vr 'u))
                                    )
                                    (+ (sqrt ,(vl 'rho)) (sqrt ,(vr 'rho)))
                                 )
                                `(/ (+ (* (sqrt ,(vl 'rho)) ,(vl 'v))
                                       (* (sqrt ,(vr 'rho)) ,(vr 'v))
                                    )
                                    (+ (sqrt ,(vl 'rho)) (sqrt ,(vr 'rho)))
                                 )
                                `(/ (+ (* (sqrt ,(vl 'rho)) ,(vl 'w))
                                       (* (sqrt ,(vr 'rho)) ,(vr 'w))
                                    )
                                    (+ (sqrt ,(vl 'rho)) (sqrt ,(vr 'rho)))
                                 )
               ) v)
          )
    )
    )))
    self
  )
))

(define Roe:lam (lambda (d)
  (lambda (vm)
    (abs2 ((PHYS:chrs d) vm))
  )
))

(define Roe:dFl (lambda (d gr i)
  (let ((vm (ADV:vm (gr 'var-l i d) (gr 'var-r i d))))
    (zip (map (lamapp mul2)
              (zip (arr-elements ((PHYS:DS d) vm))
                   (arr-cols ((PHYS:R d) vm))
              )
         )
         (arr-elements ((PHYS:chrs d) vm))
    )
  )
))

(define Roe:dF (lambda (d gr i)
  (let ((vm (ADV:vm (gr 'var-l i d) (gr 'var-r i d))))
    (mul2 0.5
          (apply add
                 (map (lamapp mul2)
                      (zip (map car (Roe:dFl d gr i))
                           (arr-elements ((ADV:lam d) vm))
                      )
                 )
          )
    )
  )
))

)

(import (grid-gen main))
(set-comp-order 1)
(set! ADV:dF Roe:dF)
(set! ADV:dFl Roe:dFl)
(set! ADV:vm  Roe:vm)
(set! ADV:lam Roe:lam)
(set! ADV:dF1
      (lambda (d gr i)
        (apply math-cvector
               (map (lamcon 0.0) (iota1 (PHYS:qlen (gr 'ndims))))
        )
      )
)
